home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1986 March & April / rerun-1986-03-04.d64 / metronome 64 (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  190 lines

  1. 0 poke808,239:rem disable stop key
  2. 10 rem ******************************
  3. 11 rem * maelzel's modern metronome *
  4. 12 rem *     by  robert s. owen     *
  5. 13 rem *        dedicated to        *
  6. 14 rem *       jimmy thompson       *
  7. 15 rem ******************************
  8. 100 gosub5000
  9. 300 printchr$(150)
  10. 310 pokes,0:pokevic+2,136:poke198,0
  11. 311 printchr$(19)tab(38)sp$" "
  12. 312 printchr$(19)tab(38)tp$"_"
  13. 320 gosub7300:geta$:ifa$=""then320
  14. 321 ifa$="3"then320
  15. 322 ifa$<>chr$(13)then325
  16. 324 goto380
  17. 325 ifa$<>chr$(141)then330
  18. 327 printchr$(19)tab(38)tp$" "
  19. 328 goto7000
  20. 330 ifa$<"1"ora$>"9"then320
  21. 331 t$=a$:printchr$(19)tab(28)tp$chr$(18)t$"  "
  22. 340 gosub7300:geta$:ifa$=""then340
  23. 345 ifa$<"0"ora$>"9"then340
  24. 346 ift$="2"thenifa$>"0"then340
  25. 350 t$=t$+a$:printchr$(19)tab(28)tp$chr$(18)t$" "
  26. 351 ifval(t$)>39then380
  27. 360 gosub7300:geta$:ifa$=""then360
  28. 365 ifa$<"0"ora$>"9"then360
  29. 370 t$=t$+a$
  30. 380 printchr$(19)tab(28)tp$chr$(146)t$" "
  31. 390 ts=.935*val(t$)+35.6:pokevic+1,ts
  32. 395 printchr$(19)tab(38)tp$" "
  33. 396 printchr$(19)tab(38)bt$"_"
  34. 520 gosub7300:geta$:ifa$=""then520
  35. 521 ifa$=chr$(13)then580
  36. 525 ifa$<"1"ora$>"8"then520
  37. 530 b$=a$:printchr$(19)tab(28)bt$chr$(18)b$"/ "
  38. 540 gosub7300:geta$:ifa$=""then540
  39. 541 ifa$=chr$(13)then540
  40. 545 ifa$<>"1"anda$<>"2"anda$<>"4"anda$<>"8"then540
  41. 550 bb$=a$:printchr$(19)tab(28)bt$chr$(146)b$"/"bb$
  42. 580 printchr$(19)tab(38)bt$" "
  43. 581 printchr$(19)tab(38)gg$"_"
  44. 610 gosub7300:geta$:ifa$<>chr$(13)then610
  45. 680 printchr$(19)tab(38)gg$" "
  46. 681 printchr$(19)tab(38)sp$"_"
  47. 1010 tt=(1/val(t$))*(3600-((val(t$)/70)*175)):rem contains a fudge factor
  48. 1015 l=136-((1/val(t$))*4760):ifl<17thenl=17
  49. 1016 h=136+((1/val(t$))*4760):ifh>255thenh=255
  50. 1020 b=val(b$)
  51. 1030 ifb=6andbb$="8"thenb=2
  52. 1040 ifb=1then2010
  53. 1050 ifb=5orb=7thenifbb$>"1"then2050
  54. 1060 goto2020
  55. 2010 gosub2060:ifpeek(k)=0then2010
  56. 2011 goto310
  57. 2020 gosub2060:fori=1to(b-1):gosub2080:nexti:ifpeek(k)=0then2020
  58. 2021 goto310
  59. 2050 ifb=7thengosub2060:gosub2080:ifpeek(k)>0then310
  60. 2055 gosub2060:gosub2080:ifpeek(k)>0then310
  61. 2057 gosub2060:gosub2080:gosub2080:ifpeek(k)=0then2050
  62. 2058 goto310
  63. 2060 ti$="000000":gosub7310
  64. 2062 ifti<3then2062
  65. 2063 pokes,0
  66. 2065 ifpeek(k)>0thenreturn
  67. 2066 p=peek(spr)+5*d:ifp<lorp>hthenp=peek(spr)
  68. 2067 pokespr,p:ifti<ttthen2065
  69. 2070 pokes,33:d=d*-1:return
  70. 2080 ti$="000000"
  71. 2082 ifti<3then2082
  72. 2083 pokes,0
  73. 2085 ifpeek(k)>0thenreturn
  74. 2086 p=peek(spr)+5*d:ifp<lorp>hthenp=peek(spr)
  75. 2087 pokespr,p:ifti<ttthen2085
  76. 2090 pokes,17:d=d*-1:return
  77. 5000 rem **soune set-up**
  78. 5010 fori=54272to54300:pokei,0:next
  79. 5020 poke54273,200:poke54277,4:poke54296,15
  80. 5030 s=54276
  81. 5100 rem **sprite set-up**
  82. 5110 vic=53248:spr=vic+2:pokevic+32,0:pokevic+33,6:pokevic+27,255
  83. 5115 pokevic+39,3:pokevic+40,7
  84. 5120 poke2040,13:fori=0to14:poke832+i,255:next:fori=15to62:poke832+i,0:next
  85. 5121 poke2041,14:fori=0to32:poke896+i,255:next:fori=33to62:poke896+i,0:next
  86. 5130 pokevic+21,3:pokevic,136:pokevic+2,136:pokevic+3,52
  87. 5500 rem **initialize variables**
  88. 5510 dn$="":rem cursor down in quotes
  89. 5511 al$=""
  90. 5512 tp$=dn$+al$
  91. 5513 bt$=dn$+tp$
  92. 5514 gg$=dn$+bt$
  93. 5515 sp$=dn$+gg$
  94. 5540 d=1:k=198
  95. 5550 tn=56328:sc=56329:mn=56330:hr=56331
  96. 5560 pokehr,0:pokemn,0:pokesc,0:poketn,0
  97. 5570 printchr$(8):rem disable upper/lower case shift
  98. 6000 rem **screen set-up**
  99. 6010 printchr$(142)chr$(147)tab(32)chr$(18)chr$(144)"  00:00 ";
  100. 6020 printchr$(146)chr$(152)spc(15)chr$(193);
  101. 6021 printspc(16)chr$(18)chr$(144)"        ";:rem eight spaces in quotes
  102. 6030 printchr$(146)chr$(144);
  103. 6031 fori=1to14:printchr$(163);:nexti
  104. 6032 printchr$(152)chr$(18)chr$(169)" ";
  105. 6035 printchr$(223)chr$(146)chr$(144);
  106. 6036 fori=1to23:printchr$(163);:nexti:printchr$(152);
  107. 6040 printspc(3)chr$(154)"grave/largo "chr$(152)chr$(123);
  108. 6041 printspc(12)chr$(144)"s"chr$(152)
  109. 6050 printspc(9)chr$(154)"lento "chr$(152)chr$(123);
  110. 6051 printspc(12)chr$(144)"h "chr$(176)" "chr$(152)"clock"
  111. 6060 printspc(8)chr$(154)"adagio "chr$(152)chr$(123);
  112. 6061 printspc(12)chr$(144)"i"chr$(195)chr$(179)chr$(152)
  113. 6070 printspc(5)chr$(154)"larghetto "chr$(152)chr$(123);
  114. 6071 printspc(12)chr$(144)"f "chr$(173)"  "chr$(152)"quit"
  115. 6080 printspc(7)chr$(154)"andante "chr$(152)chr$(123);
  116. 6081 printspc(12)chr$(144)"t"chr$(152)
  117. 6090 printspc(5)chr$(154)"andantino "chr$(152)chr$(123);
  118. 6091 printspc(12)chr$(144)chr$(94)chr$(152)
  119. 6100 printspc(6)chr$(154)"moderato "chr$(152)chr$(123);
  120. 6101 printspc(12)chr$(144)chr$(202)chr$(195)chr$(195);
  121. 6102 printchr$(195)chr$(195)chr$(195)chr$(201)chr$(152)
  122. 6110 printspc(15)chr$(123);
  123. 6111 printspc(12)chr$(150)"120"chr$(152)" tempo"
  124. 6115 t$="120":pokevic+1,.935*val(t$)+35.6
  125. 6120 printspc(4)chr$(154)"allegretto "chr$(152)chr$(123);
  126. 6121 printspc(12)chr$(163)chr$(163)chr$(163)
  127. 6130 printspc(15)chr$(123)
  128. 6140 printspc(7)chr$(154)"allegro "chr$(152)chr$(123)
  129. 6150 printspc(15)chr$(123);
  130. 6151 printspc(12)chr$(150)"4/4"chr$(152)"  beat"
  131. 6155 b$="4":bb$="4"
  132. 6160 printspc(9)chr$(154)"assai "chr$(152)chr$(123);
  133. 6161 printspc(12)chr$(163)chr$(163)chr$(163)
  134. 6170 printspc(7)chr$(154)"vivache "chr$(152)chr$(123)
  135. 6180 printspc(15)chr$(123)
  136. 6190 printspc(15)chr$(123);
  137. 6191 printspc(19)"go"
  138. 6200 printspc(8)chr$(154)"presto "chr$(152)chr$(123)
  139. 6210 printspc(15)chr$(123)
  140. 6220 printspc(15)chr$(123)
  141. 6230 printspc(3)chr$(154)"prestissimo "chr$(152)chr$(123);
  142. 6231 printspc(17)"stop"
  143. 6240 printspc(13)chr$(152)chr$(18)chr$(169)"   "chr$(127)chr$(146)
  144. 6250 printspc(11)chr$(152)chr$(117)chr$(18)"       ";:rem seven spaces in quote
  145. 6251 printchr$(146)chr$(105)chr$(145);
  146. 6999 return
  147. 7000 rem **time set routine**
  148. 7110 printchr$(19)tab(38)dn$"_"
  149. 7120 geta$:ifa$=chr$(13)then7180
  150. 7125 ifa$<"/"ora$>"9"then7120
  151. 7126 ifa$>"1"thenifa$<":"thenhh=0:th$="0":goto7146
  152. 7130 th$=a$:printchr$(19)tab(34)th$" :  "
  153. 7131 hh=val(a$)*16
  154. 7140 geta$:ifa$=<"/"ora$>"9"then7140
  155. 7145 ifval(th$+a$)>12then7140
  156. 7146 th$=th$+a$:printchr$(19)tab(34)th$":  "
  157. 7147 hl=val(a$)
  158. 7148 pokehr,hh+hl
  159. 7150 geta$:ifa$=<"/"ora$>"5"then7150
  160. 7155 tm$=a$:printchr$(19)tab(34)th$":"tm$
  161. 7156 mh=val(a$)*16
  162. 7160 geta$:ifa$=<"/"ora$>"9"then7160
  163. 7164 tm$=tm$+a$
  164. 7165 printchr$(19)tab(34)chr$(18)chr$(144)th$":"tm$chr$(146)chr$(150)
  165. 7166 ml=val(a$)
  166. 7167 pokemn,mh+ml
  167. 7168 pokesc,0:poketn,0
  168. 7180 printchr$(19)tab(38)dn$" "
  169. 7181 printchr$(19)tab(38)al$"_"
  170. 7200 rem **check quit routine**
  171. 7220 gosub7300:geta$:ifa$=""then7220
  172. 7230 ifa$=chr$(141)then7500
  173. 7240 ifa$=chr$(13)then7260
  174. 7250 goto7220
  175. 7260 printchr$(19)tab(38)al$" "
  176. 7270 goto310
  177. 7300 rem **update clock routine**
  178. 7310 ifpeek(mn)=(mh*16)+mlthenreturn
  179. 7320 hh=(peek(hr)and112)/16:hl=(peek(hr)and15)
  180. 7330 mh=(peek(mn)and240)/16:ml=(peek(mn)and15)
  181. 7335 du=peek(tn)
  182. 7340 printchr$(19)chr$(18)chr$(144)tab(34)chr$(hh+48)chr$(hl+48);
  183. 7341 print":"chr$(mh+48)+chr$(ml+48)chr$(146)chr$(150)
  184. 7350 return
  185. 7500 rem **quit routine**
  186. 7510 poke53269,0
  187. 7520 printchr$(147)chr$(154):poke53280,14:poke53281,6
  188. 7530 printchr$(9):poke808,237
  189. 7540 end
  190.